home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / nrpas13.zip / RAN0.DEM < prev    next >
Text File  |  1991-04-29  |  2KB  |  57 lines
  1. PROGRAM d7r1 (input,output);
  2. (* driver for routine RAN0 *)
  3. (* calculates pi statistically using volume of unit n-sphere *)
  4. CONST
  5.    pi=3.1415926;
  6. VAR
  7.    i,j,k,idum,jpower : integer;
  8.    x1,x2,x3,x4 : real;
  9.    iy : ARRAY [1..3] OF integer;
  10.    yprob : ARRAY [1..3] OF real;
  11.    gliseed : integer;
  12.    gly : real;
  13.    glv : ARRAY [1..97] OF real;
  14.  
  15. FUNCTION fnc(x1,x2,x3,x4 : real) : real;
  16. BEGIN
  17.    fnc := sqrt(sqr(x1)+sqr(x2)+sqr(x3)+sqr(x4))
  18. END;
  19.  
  20. FUNCTION twotoj(j : integer): integer;
  21. BEGIN
  22.    IF (j=0) THEN twotoj := 1
  23.    ELSE twotoj := 2*twotoj(j-1)
  24. END;
  25.  
  26. (*$I MODFILE.PAS *)
  27. (*$I RAN0.PAS *)
  28.  
  29. BEGIN
  30.    idum := -1;
  31.    FOR i := 1 to 3 DO BEGIN
  32.       iy[i] := 0
  33.    END;
  34.    writeln;
  35.    writeln ('volume of unit n-sphere, n = 2,3,4');
  36.    writeln ('# points','     pi     ','  (4/3)*pi  ',' (1/2)*pi^2 ');
  37.    writeln;
  38.    FOR j := 1 to 13 DO BEGIN
  39.       FOR k := twotoj(j-1) to twotoj(j) DO BEGIN
  40.          x1 := ran0(idum);
  41.          x2 := ran0(idum);
  42.          x3 := ran0(idum);
  43.          x4 := ran0(idum);
  44.          IF (fnc(x1,x2,0.0,0.0) < 1.0) THEN  iy[1] := iy[1]+1;
  45.          IF (fnc(x1,x2,x3,0.0) < 1.0) THEN  iy[2] := iy[2]+1;
  46.          IF (fnc(x1,x2,x3,x4) < 1.0) THEN  iy[3] := iy[3]+1
  47.       END;
  48.       jpower := twotoj(j);
  49.       yprob[1] := 4.0*iy[1]/jpower;
  50.       yprob[2] := 8.0*iy[2]/jpower;
  51.       yprob[3] := 16.0*iy[3]/jpower;
  52.       writeln (jpower:6,yprob[1]:12:6,yprob[2]:12:6,yprob[3]:12:6)
  53.    END;
  54.    writeln;
  55.    writeln ('actual',pi:12:6,(4.0*pi/3.0):12:6,(0.5*sqr(pi)):12:6)
  56. END.
  57.